home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 25
/
Cream of the Crop 25.iso
/
program
/
tvichw32.zip
/
MAIN.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1997-03-13
|
11KB
|
421 lines
unit Main;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,IniFiles,
Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus, Spin, Grids,
HW_32;
type
TMainForm = class(TForm)
GroupBox2: TGroupBox;
B_Read: TButton;
B_ReadAll: TButton;
B_Write: TButton;
B_WriteAll: TButton;
BitBtn3: TBitBtn;
GroupBox3: TGroupBox;
Label12: TLabel;
E_Addr: TEdit;
B_SetMemory: TButton;
B_ReadMemory: TButton;
B_Open: TButton;
GRead: TStringGrid;
MemoHex: TStringGrid;
GWrite: TStringGrid;
GroupBox1: TGroupBox;
Timer1: TTimer;
L_Flag: TLabel;
L_Gen: TLabel;
Label1: TLabel;
Label2: TLabel;
B_SetIRQ: TButton;
B_Mask: TButton;
SpinIRQ: TSpinEdit;
Label5: TLabel;
B_FillMemory: TButton;
B_Pulse: TButton;
L_Timers: TLabel;
Label7: TLabel;
C_Hard: TCheckBox;
Panel1: TPanel;
Label4: TLabel;
Label6: TLabel;
Label8: TLabel;
Label9: TLabel;
Label3: TLabel;
HwCtrl: TVicHw32;
procedure B_OpenClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormActivate(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure GReadSelectCell(Sender: TObject; Col, Row: Longint;
var CanSelect: Boolean);
procedure B_WriteClick(Sender: TObject);
procedure B_WriteAllClick(Sender: TObject);
procedure B_ReadClick(Sender: TObject);
procedure B_ReadAllClick(Sender: TObject);
procedure B_SetMemoryClick(Sender: TObject);
procedure B_ReadMemoryClick(Sender: TObject);
procedure E_AddrChange(Sender: TObject);
procedure HWCtrlHwInterrupt(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure B_SetIRQClick(Sender: TObject);
procedure B_MaskClick(Sender: TObject);
procedure SpinIRQChange(Sender: TObject);
procedure B_FillMemoryClick(Sender: TObject);
procedure B_PulseClick(Sender: TObject);
procedure C_HardClick(Sender: TObject);
end;
const MaxPorts = 16;
var
MainForm: TMainForm;
PortWSel,PortRSel:Word;
ValWSel:Byte;
NomWSel,NomRSel:Byte;
PhysAddr : dWord;
TestString : array[0..255]of Char;
TestVar : LongInt;
type SingleData = array[1..16] of Byte;
SegData = array[1..16] of SingleData;
tPointPhys =^SegData;
var PointPhys : tPointPhys;
Flag_Intr : LongInt;
Flag_tim : LongInt;
Sum_Ticks,CurrTicker, OldTicker : Longint;
implementation
{$R *.DFM}
procedure ShowButtons;
begin
with MainForm,HwCtrl do
begin
C_Hard.Checked:=HardAccess;
SpinIRQ.Enabled:=not IsIRQSet;
if ActiveHW then B_Open.caption:='Close Driver'
else B_Open.caption:='Open Driver';
B_Write.Enabled:=ActiveHW;
B_Read.Enabled:=ActiveHW;
B_WriteAll.Enabled:=ActiveHW;
B_ReadAll.Enabled:=ActiveHW;
B_ReadMemory.Enabled:=ActiveHW and (PointPhys<>NIL);
B_FillMemory.Enabled:=ActiveHW and (PointPhys<>NIL);
B_SetIRQ.Enabled:=ActiveHW;
if IsIRQSet then B_SetIRQ.caption:='Destroy IRQ'
else B_SetIRQ.caption:='Set IRQ';
B_Pulse.Enabled:=ActiveHW and IsIRQSet and Masked;
B_Mask.Enabled:=ActiveHW and IsIRQSet;
if Masked then B_Mask.caption:='Unmask IRQ'
else B_Mask.caption:='Mask IRQ';
end;
end;
procedure TMainForm.B_OpenClick(Sender: TObject);
begin
if HwCtrl.ActiveHW then begin HwCtrl.CloseDriver; PointPhys:=NIL; end
else begin
HwCtrl.OpenDriver;
if not HwCtrl.ActiveHW then
begin
MessageBeep(0);
Application.MessageBox('Driver "VICHWxx" not found',
' Warning! ',mb_OK or mb_ICONHAND);
end;
end;
B_SetMemory.Enabled:=HwCtrl.ActiveHW;
ShowButtons;
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
HwCtrl.CloseDriver;
ShowButtons;
end;
procedure TMainForm.FormActivate(Sender: TObject);
var MyIniFile : TIniFile;
i : Word;
begin
MyInifile:=TIniFile.Create('HW_test.ini');
with MyIniFile,HWCtrl do
begin
if GetVersion<0 then Label3.caption:='Detected: Windows 95'
else Label3.caption:='Detected: Windows NT';
PhysAddr:=ReadInteger('misc','ADDR',$F8000);
IRQNumber:=ReadInteger('misc','IRQ',10);
SpinIRQ.Value:=IRQNumber;
E_Addr.text:=IntToHex(PhysAddr,8);
for i:=1 to MaxPorts do
begin
with GWrite do
begin
Cells[0,i]:=IntToStr(i);
Cells[1,0]:='PORT'; Cells[2,0]:='VAL';
Cells[1,i]:=ReadString('PortW','Port'+IntToStr(i),'');
Cells[2,i]:=ReadString('Values','Val'+IntToStr(i),'');
end;
with GRead do
begin
Cells[0,i]:=IntToStr(i);
Cells[1,0]:='PORT'; Cells[2,0]:='VAL';
Cells[1,i]:=ReadString('PortR','Port'+IntToStr(i),'');
end;
end;
end;
MyIniFile.Free;
with MemoHex do
begin
Cells[0,0]:=' ADDR';
Cells[1,0]:=' HEX';
Cells[2,0]:=' ASCII';
end;
ShowButtons;
end;
procedure TMainForm.BitBtn3Click(Sender: TObject);
var MyIniFile : TIniFile;
i : Word;
begin
MyInifile:=TIniFile.Create('HW_test.ini');
with MyIniFile,HWCtrl do
begin
WriteInteger('misc','ADDR',PhysAddr);
WriteInteger('misc','IRQ',IRQNumber);
for i:=1 to MaxPorts do
begin
with GWrite do
begin
WriteString('PortW','Port'+IntToStr(i),Cells[1,i]);
WriteString('Values','Val'+IntToStr(i),Cells[2,i]);
end;
with GRead do
begin
WriteString('PortR','Port'+IntToStr(i),Cells[1,i]);
end;
end;
end;
MyIniFile.Free;
Close;
end;
function HexToInt(s:String):dWord;
const hexch:array[0..15] of Char='0123456789ABCDEF';
var i,j : Byte;
r,n,k:dWord;
ch : Char;
begin
k:=1; r:=0;
for i:=Length(s) downto 1 do
begin
ch:=s[i]; n:=0;
for j:=0 to 15 do if UpperCase(ch)=hexch[j] then n:=j;
r:=r+n*k; if i>1 then k:=k*16;
end;
Result:=r;
end;
procedure TMainForm.GReadSelectCell(Sender: TObject; Col, Row: Longint;
var CanSelect: Boolean);
begin
with GRead do
begin
PortRSel:=HexToInt(Cells[1,Row]); NomRSel:=Row;
end;
end;
procedure TMainForm.B_WriteClick(Sender: TObject);
begin
with GWrite,HwCtrl do
begin
PortWSel:=HexToInt(Cells[1,Row]); Cells[1,Row]:=IntToHex(PortWSel,4);
ValWSel:=HexToInt(Cells[2,Row]); Cells[2,Row]:=IntToHex(ValWSel,2);
NomWSel:=Row;
if (PortWSel=0) then begin MessageBeep(0); Exit; end;
Port[PortWSel] :=ValWSel;
end;
end;
procedure TMainForm.B_WriteAllClick(Sender: TObject);
var i,v : Byte;
P,N : Word;
values : array[1..16] of Byte;
ports : array[1..16] of Word;
begin
with GWrite,HwCtrl do
begin
N:=0;
for i:=1 to MaxPorts do
begin
P:=HexToInt(Cells[1,i]); Cells[1,i]:=IntToHex(P,4);
if p>0 then
begin
V:=HexToInt(Cells[2,i]); Cells[2,i]:=IntToHex(v,2);
Inc(N); values[N]:=V; ports[N]:=P;
Port[P]:=V;
end;
end;
end;
end;
procedure TMainForm.B_ReadClick(Sender: TObject);
var b : Byte;
begin
with GRead,HwCtrl do
begin
PortRSel:=HexToInt(Cells[1,Row]); Cells[1,Row]:=IntToHex(PortRSel,4);
NomRSel:=Row;
if (PortRSel=0) then begin MessageBeep(0); Exit; end;
b:=Port[PortRSel];
Cells[2,Row]:=IntToHex(b,2);
end;
end;
procedure TMainForm.B_ReadAllClick(Sender: TObject);
var i,b : Byte;
P,N : Word;
cl : array[1..16] of Byte;
ports : array[1..16] of Word;
begin
with GRead,HwCtrl do
begin
N:=0;
for i:=1 to MaxPorts do
begin
P:=HexToInt(Cells[1,i]); Cells[1,i]:=IntToHex(P,4);
if p>0 then
begin
Inc(N); ports[N]:=P; cl[N]:=i;
end;
end;
for i:=1 to N do
begin
b:=Port[ports[i]];
Cells[2,cl[i]]:=IntToHex(b,2);
end;
end;
end;
procedure TMainForm.B_SetMemoryClick(Sender: TObject);
begin
PhysAddr:=HexToInt(E_Addr.text); E_Addr.Text:=IntToHex(PhysAddr,8);
with HwCtrl do PointPhys:=MapPhysToLinear(PhysAddr,256);
B_SetMemory.Enabled:=FALSE;
ShowButtons;
end;
procedure TMainForm.B_ReadMemoryClick(Sender: TObject);
var CurrAddr,i,j : dWord;
s : String;
b : Byte;
ch : Char;
begin
if PointPhys<>NIL then
begin
CurrAddr:=PhysAddr;
for i:=1 to 16 do
begin
s:=IntToHex(CurrAddr,8); MemoHex.Cells[0,i]:=s; s:='';
for j:=1 to 16 do s:=s+IntToHex(PointPhys^[i][j],2);
MemoHex.Cells[1,i]:=s; s:='';
for j:=1 to 16 do
begin
b:=PointPhys^[i][j];
if b>=$20 then ch:=Char(b) else ch:='.'; s:=s+ch;
end;
MemoHex.Cells[2,i]:=s;
CurrAddr:=CurrAddr+16;
end;
end;
end;
procedure TMainForm.E_AddrChange(Sender: TObject);
begin
B_SetMemory.Enabled:=HwCtrl.ActiveHW;;
end;
procedure TMainForm.HWCtrlHwInterrupt(Sender: TObject);
begin
Inc(Flag_Intr);
end;
procedure TMainForm.Timer1Timer(Sender: TObject);
begin
with HWCtrl do
begin
L_Gen.Caption:=IntToStr(IRQCounter);
L_Timers.Caption:=IntToStr(Flag_tim div 1000);
L_Flag.Caption:=IntToStr(Flag_Intr);
if ActiveHW and IsIRQSet and not Masked then
begin
CurrTicker:=GetTickCount;
Flag_Tim:=Sum_Ticks+CurrTicker-OldTicker;
end else OldTicker:=GetTickCount;
end;
end;
procedure TMainForm.B_SetIRQClick(Sender: TObject);
begin
with HWCtrl do
begin
Flag_Intr:=0;
IRQNumber:=SpinIRQ.Value; Flag_tim:=0;
if not IsIRQSet then SetIRQ else DestroyIRQ; Sum_Ticks:=0;
ShowButtons;
end;
end;
procedure TMainForm.B_MaskClick(Sender: TObject);
begin
with HWCtrl do
begin
if not Masked then
begin
MaskInterrupt;
Sum_Ticks:=Flag_Tim;
end
else UnmaskInterrupt;
ShowButtons;
end;
end;
procedure TMainForm.SpinIRQChange(Sender: TObject);
begin
HWCtrl.IRQNumber:=SpinIRQ.Value;
end;
procedure TMainForm.B_FillMemoryClick(Sender: TObject);
var i,j : byte;
begin
if PointPhys<>NIL then
begin
for i:=1 to 16 do
begin
for j:=1 to 16 do PointPhys^[i][j]:=16*(i-1)+j-1;
end;
end;
end;
procedure TMainForm.B_PulseClick(Sender: TObject);
begin
HwCtrl.SimulateHwInt;
end;
procedure TMainForm.C_HardClick(Sender: TObject);
begin
HwCtrl.HardAccess:=C_Hard.Checked;
end;
initialization
NomWSel:=0; NomRSel:=0; PointPhys:=NIL; Flag_Intr:=0; Flag_tim:=0;
Sum_Ticks:=0;CurrTicker:=0; OldTicker:=0;
end.